home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / allowo1g / domrecur.frm (.txt) < prev    next >
Visual Basic Form  |  1999-08-27  |  4KB  |  106 lines
  1. VERSION 5.00
  2. Begin VB.Form frmDOMRecurse 
  3.    BackColor       =   &H00FFFFFF&
  4.    Caption         =   "DOM Recursion"
  5.    ClientHeight    =   4350
  6.    ClientLeft      =   60
  7.    ClientTop       =   630
  8.    ClientWidth     =   6375
  9.    LinkTopic       =   "Form1"
  10.    MDIChild        =   -1  'True
  11.    ScaleHeight     =   4350
  12.    ScaleWidth      =   6375
  13.    Visible         =   0   'False
  14.    WindowState     =   2  'Maximized
  15.    Begin VB.ListBox lst 
  16.       Appearance      =   0  'Flat
  17.       Height          =   1080
  18.       IntegralHeight  =   0   'False
  19.       Left            =   240
  20.       TabIndex        =   0
  21.       Top             =   120
  22.       Visible         =   0   'False
  23.       Width           =   2055
  24.    End
  25.    Begin VB.Menu mnuFileMenu 
  26.       Caption         =   "&File"
  27.       Begin VB.Menu mnuFileClose 
  28.          Caption         =   "&Close"
  29.       End
  30.    End
  31. Attribute VB_Name = "frmDOMRecurse"
  32. Attribute VB_GlobalNameSpace = False
  33. Attribute VB_Creatable = False
  34. Attribute VB_PredeclaredId = True
  35. Attribute VB_Exposed = False
  36. Option Explicit
  37. ' DOMRecurse.frm    July 1999  contact markb@orionstudios.com
  38. ' Demonstrates recursive traversal of the Document Object Mode (DOM)
  39. '   Recurse Method: displays HTML document tree from StartFromNode in a List Box.
  40. ' Includes routines to set ListBox tabs and horizontal scroll bar
  41. ' Uses  DOMRecurse.cls
  42. '================================================================================
  43. ' Relevant nodeType values
  44. Private Const ELEMENT_NODE = 1
  45. Private Const TEXT_NODE = 3
  46. ' Module-level Variables
  47. Private WithEvents mDOMRecurse As DOMRecurse    ' see mDOMRecurse_NodeEvent
  48. Attribute mDOMRecurse.VB_VarHelpID = -1
  49. ' WinAPI Declarations
  50. Private Const LB_SETTABSTOPS = &H192
  51. Private Const LB_SETHORIZONTALEXTENT = &H194
  52. Private Declare Function SendMessageByRef Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Long) As Long
  53. Private Declare Function SendMessageByVal Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  54. Public Sub Recurse(StartFromNode As MSHTML.IHTMLDOMNode)
  55.     On Error GoTo Recurse_Error
  56. '    Me.MousePointer = vbHourglass
  57.     SetLBTabs lst.hWnd, 6, 12, 18, 24, 30, 36, 42, 48
  58.     SetLBHScrollBar LBhWnd:=lst.hWnd, PixelWidth:=600
  59.     Set mDOMRecurse = New DOMRecurse ' instantiate WithEvents module-level variable
  60.     mDOMRecurse.RecurseFromNode StartNode:=StartFromNode
  61.     Set mDOMRecurse = Nothing
  62. Recurse_Exit:
  63. '    Me.MousePointer = vbDefault
  64.     lst.Visible = True
  65.     Exit Sub
  66. Recurse_Error:
  67.     MsgBox Err.Number & " - " & Err.Description, vbExclamation, Me.Name & ".Recurse"
  68.     Resume Recurse_Exit
  69. End Sub
  70. Private Sub Form_Resize()
  71.     On Error Resume Next
  72.     lst.Move 0, 0, Me.ScaleWidth, Me.ScaleHeight
  73. End Sub
  74. Private Sub mnuFileClose_Click()
  75.     Unload Me
  76. End Sub
  77. Private Sub mDOMRecurse_NodeEvent(DOMNode As MSHTML.IHTMLDOMNode, ByVal Depth As Long)
  78. ' Event raised for each node encountered during recursive traversal.
  79. ' "Depth" is from the root node specified by the StartFromNode Property.
  80.     Dim strNodeValue As String
  81.     With DOMNode
  82.         If .nodeType = TEXT_NODE Then
  83.             strNodeValue = .nodeValue
  84.         Else
  85.             strNodeValue = .nodeName
  86.         End If
  87.     End With
  88.     lst.AddItem String$(Depth, vbTab) & strNodeValue
  89. End Sub
  90. Public Sub SetLBTabs(LBhWnd As Long, ParamArray TabStops())
  91.     On Error GoTo SetLBTabs_Exit
  92.     Dim Tabs(0 To 7) As Long    ' Dialog units - approx Pixels*4
  93.     Dim NumOfTabs As Long
  94.     Dim IX As Long
  95.     NumOfTabs = UBound(TabStops)
  96.     For IX = 0 To NumOfTabs
  97.         Tabs(IX) = TabStops(IX) * 4
  98.     Next
  99.     NumOfTabs = NumOfTabs + 1
  100.     SendMessageByRef LBhWnd, LB_SETTABSTOPS, NumOfTabs, Tabs(0)
  101. SetLBTabs_Exit:
  102. End Sub
  103. Public Sub SetLBHScrollBar(LBhWnd As Long, PixelWidth As Long)
  104.     SendMessageByVal LBhWnd, LB_SETHORIZONTALEXTENT, PixelWidth, 0
  105. End Sub
  106.